perm filename SEGDPY.SAI[SYS,HE]1 blob
sn#009325 filedate 1972-12-06 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00005 00002 ENTRY DUMMY
00006 00003 α LOCALS, INTERNALS, AND EXTERNALS
00008 00004 α SYSTEM
00009 00005 α STATUS - PAGE 1
00011 00006 α STATUS - PAGE 2
00012 00007 α STATUS + PAGE 3
00013 00008 α PRIMITIVES - PAGE 1
00015 00009 α PRIMITIVES - PAGE 2
00017 00010 α PRIMITIVES - PAGE 3
00020 00011 α PRIMITIVES + PAGE 4
00023 00012 α INITIALIZATION SUBRS
00025 00013 α FLIT
00031 ENDMK
⊗;
ENTRY DUMMY;
BEGIN "SEGDPY - SEGMENTER'S DISPLAY ROUTINES"
REQUIRE 100 PNAMES;
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "SYMBOL.AUX[H,RPO]" SOURCE_FILE;
REQUIRE "DPYIII.AUX[H,RPO]" SOURCE_FILE;
DEFINE
APOG=<1>,
BPOG=<2>,
SPOG=<3>,
T1POG=<4>,
T2POG=<5>,
TEXT=<1>, MEDIUM=<2>, BIG=<5>,
DIM=<3>, BRIGHT=<6>;
α LOCALS, INTERNALS, AND EXTERNALS;
α INTERNALS;
INTERNAL SAFE INTEGER ARRAY
DPYAA[1:200],
DPYBB[1:100],
DPYCC[1:10];
INTERNAL BOOLEAN
DPYBOOL;
INTERNAL STRING
DPYRTS;
α LOCALS;
BOOLEAN
DB_BRK, DB_JOB, DB_LAB, DB_TELL, DB_INFO,
DB_CMD, DB_LOC, DB_INIT;
STRING
NAME, DS_JOB, DS_LAB, DS_TELL, DS_INFO, DS_CMD;
SET
ESET;
INTEGER
α DISPLAY WINDOW;
DXL,DXH,DXCTR,DXO,DDX,
DYL,DYH,DYCTR,DYO,DDY, DA;
REAL
α LOGICAL PARAMETERS;
LDX,LDY,
α SOURCE WINDOW;
SXL,SXH,SXO,SDX,
SYL,SYH,SYO,SDY, SA,
α OBJECT WINDOW;
OXL,OXH,
OYL,OYH,
MAGX,MAGY,DISX,DISY;
α EXTERNALS;
EXTERNAL INTEGER
DEBUG2;
EXTERNAL ITEMVAR
NODE,GRAPH,NMATCH;
α SYSTEM ;
INTERNAL STRING SUBR PRINTNAME(ITEMVAR X);
BEGIN "PRINTNAME"
STRING NAME; INTEGER FLAG;
NAME←CVIS(X,FLAG);
IF FLAG
THEN ⊂ IF CVN(X)>1024
THEN NAME←"G"&CVOS(CVN(X))
ELSE NAME←"L"&CVOS(CVN(X));
NEW_PNAME(X,NAME) ⊃;
RETURN(NAME);
END "PRINTNAME";
α STATUS - PAGE 1;
FORWARD ISUBR DPYS;
FORWARD ISUBR DPYBS;
FORWARD ISUBR DPYLS;
FORWARD ISUBR DPYL(ITEMVAR L);
FORWARD ISUBR DPYPTS;
FORWARD ISUBR DPYFLVS;
FORWARD ISUBR DPYNS;
FORWARD ISUBR DPYSCENE;
FORWARD ISUBR FLIT;
DEFINE
JOBLINE= <DXL+5,DYH-30>,
TELLINE= <DXCTR,DYH-25>,
LABLINE= <DXCTR,DYH-40>,
INFOLINE= <DXCTR,DYH-55>,
CMDLINE= <DXCTR,DYH-70>;
SUBR DPYFRAME;
IF DEBUG2
THEN
⊂ "DPYFRAME" AIVECT(DXL,DYL);AVECT(DXH,DYL);AVECT(DXH,DYH);
AVECT(DXL,DYH);AVECT(DXL,DYL);
AIVECT(OXL,OYL);AVECT(OXH,OYL);AVECT(OXH,OYH);
AVECT(OXL,OYH);AVECT(OXL,OYL) ⊃ "DPYFRAME";
ISUBR DPYSTAT;
IF DEBUG2
THEN
BEGIN "DPYSTAT"
DPYSET(DPYAA);
DPYBIG(MEDIUM);
DPYBRT(DIM);
DPYFRAME;
AIVECT(JOBLINE);
IF DB_BRK
THEN DPYSST("* "&DS_JOB)
ELSE DPYSST("- "&DS_JOB);
IF DB_LAB
THEN ⊂ AIVECT(LABLINE); DPYSST(DS_LAB) ⊃;
IF DB_TELL
THEN ⊂ AIVECT(TELLINE); DPYSST(DS_TELL) ⊃;
IF DB_INFO
THEN ⊂ AIVECT(INFOLINE); DPYSST(DS_INFO) ⊃;
IF DB_CMD
THEN ⊂ AIVECT(CMDLINE); DPYSST(DS_CMD) ⊃;
DPYOUT(SPOG);
END "DPYSTAT";
α STATUS - PAGE 2;
ISUBR DPYBRK;
IF DEBUG2
THEN ⊂ "DPYBRK" DB_BRK←TRUE; DPYSTAT; DPYRTS←INCHWL;
IF EQU(DPYRTS,"RUN")
THEN DEBUG2←FALSE
ELSE
IF EQU(DPYRTS,"BODIES")
THEN DPYBS
ELSE
IF EQU(DPYRTS,"LINES")
THEN DPYLS
ELSE
IF EQU(DPYRTS,"POINTS")
THEN DPYPTS
ELSE
IF EQU(DPYRTS,"FLAVORS")
THEN DPYFLVS
ELSE
IF EQU(DPYRTS,"NODES")
THEN DPYNS
ELSE
IF EQU(DPYRTS,"DEBUG")
THEN DEBUG2←TRUE
ELSE
IF EQU(DPYRTS,"LOCAL")
THEN DPYS
ELSE
IF EQU(DPYRTS,"GLOBAL")
THEN DPYSCENE
ELSE
IF EQU(DPYRTS,"FLIT")
THEN FLIT;
DB_BRK←FALSE; DPYSTAT; ⊃ "DPYBRK";
α STATUS + PAGE 3;
ISUBR DPYJOB(STRING JOBNAM);
IF DEBUG2
THEN
⊂ "DPYJOB" DB_JOB←TRUE; DS_JOB←JOBNAM; DPYSTAT; ⊃ "DPYJOB";
ISUBR DPYLAB(STRING STR);
IF DEBUG2
THEN
⊂ "DPYLAB" DB_LAB←TRUE; DS_LAB←STR; DPYBRK; ⊃ "DPYLAB";
ISUBR DPYTELL(STRING STR);
IF DEBUG2
THEN
⊂ "DPYTELL" DB_TELL←TRUE; DS_TELL←STR; DPYSTAT; ⊃ "DPYTELL";
ISUBR DPYINFO(STRING STR);
IF DEBUG2
THEN
⊂ "DPYINFO" DB_INFO←TRUE; DS_INFO←STR; DPYSTAT; ⊃ "DPYINFO";
ISUBR DPYCMD(STRING STR);
IF DEBUG2
THEN
⊂ "DPYCMD" DB_CMD←TRUE; DS_CMD←STR; DPYSTAT; ⊃ "DPYCMD";
α PRIMITIVES - PAGE 1;
ISUBR DPYPT(SAFE REAL ARRAY ITEMVAR PT);
IF DEBUG2
THEN
⊂ "DPYPT"
NAME←PRINTNAME(PT);
DPYSET(DPYCC);
DPYBIG(TEXT);
DPYBRT(BRIGHT);
IF NAME="G"
THEN AIVECT($ #X(PT)-10,$ #Y(PT)-10)
ELSE AIVECT(#X(PT)-10,#Y(PT)-10);
DPYSST("o"&NAME);
DPYOUT(T1POG);
DPYBRK;
HYDPOG(T1POG) ⊃ "DPYPT";
ISUBR DPYPTS;
IF DEBUG2
THEN
⊂ "DPYPTS"
SAFE REAL ARRAY ITEMVAR P;ITEMVAR L;
DPYSET(DPYAA);
DPYBIG(TEXT);
DPYBRT(DIM);
IF ¬DB_LOC
THEN ∀ L|LINE⊗SCENE≡L DO DPYL(L);
∀ P|POINT⊗SCENE≡P DO
⊂ AIVECT(#X(P)-10,#Y(P)-10);
DPYSST(PRINTNAME(P)) ⊃;
DPYOUT(T1POG);
DPYINFO("POINTS");
DPYBRK;
HYDPOG(T1POG) ⊃ "DPYPTS";
α PRIMITIVES - PAGE 2;
ISUBR DPYFLVS;
IF DEBUG2
THEN
⊂ "DPYFLVS"
SAFE REAL ARRAY ITEMVAR P;ITEMVAR L,F;
DPYSET(DPYAA);
DPYBIG(TEXT);
DPYBRT(DIM);
IF ¬DB_LOC
THEN ∀ L|LINE⊗SCENE≡L DO DPYL(L);
∀ P,F|POINT⊗SCENE≡P ∧ FLAVOR⊗P≡F DO
⊂ AIVECT(#X(P)-10,#Y(P)-10);
DPYSST(PRINTNAME(F)) ⊃;
DPYOUT(T1POG);
DPYINFO("FLAVORS");
DPYBRK;
HYDPOG(T1POG) ⊃ "DPYFLVS";
ISUBR DPYNS;
IF DEBUG2
THEN
⊂ "DPYNS"
SAFE REAL ARRAY ITEMVAR P;ITEMVAR L,N;
DPYSET(DPYAA);
DPYBIG(TEXT);
DPYBRT(DIM);
IF ¬DB_LOC
THEN ∀ L|LINE⊗SCENE≡L DO DPYL(L);
∀ N,P|NODE⊗GRAPH≡N ∧ NMATCH⊗N≡P DO
⊂ AIVECT(#X(P)-10,#Y(P)-10);
DPYSST("*") ⊃;
DPYOUT(T1POG);
DPYINFO("NODES");
DPYBRK;
HYDPOG(T1POG) ⊃ "DPYNS";
α PRIMITIVES - PAGE 3;
ISUBR DPYL(ITEMVAR L);
IF DEBUG2
THEN
⊂ "DPYL"
SAFE REAL ARRAY ITEMVAR V1,V2;
NAME←PRINTNAME(L);
IF NAME="G"
THEN ⊂ ESET← $ ENDPT⊗L;
IF LENGTH(ESET)≠2
THEN ⊂ TYPE "BAD LINE:"&NAME EOM;
RETURN ⊃;
V1←LOP(ESET);
V2←COP(ESET);
AIVECT($ #X(V1), $ #Y(V1));
AVECT($ #X(V2), $ #Y(V2)) ⊃
ELSE ⊂ ESET← ENDPT⊗L;
IF LENGTH(ESET)≠2
THEN ⊂ TYPE "BAD LINE:"&NAME EOM;
RETURN ⊃;
V1←LOP(ESET);
V2←COP(ESET);
AIVECT(#X(V1), #Y(V1));
AVECT(#X(V2), #Y(V2)) ⊃ ⊃ "DPYL";
ISUBR DPYLN(ITEMVAR L);
IF DEBUG2
THEN
⊂ "DPYLN"
REAL X,Y;
SAFE REAL ARRAY ITEMVAR V1,V2;
NAME←PRINTNAME(L);
IF NAME="G"
THEN ⊂ ESET← $ ENDPT⊗L;
IF LENGTH(ESET)≠2
THEN ⊂ TYPE "BAD LINE:"&NAME EOM;
RETURN ⊃;
V1←LOP(ESET);
V2←COP(ESET);
X← ( $ #X(V1) + $ #X(V2) )/2;
Y← ( $ #Y(V1) + $ #Y(V2) )/2 ⊃
ELSE ⊂ ESET← ENDPT⊗L;
IF LENGTH(ESET)≠2
THEN ⊂ TYPE "BAD LINE:"&NAME EOM;
RETURN ⊃;
V1←LOP(ESET);
V2←COP(ESET);
X← ( #X(V1)+#X(V2))/2;
Y← ( #Y(V1)+#Y(V2))/2 ⊃;
AIVECT(X-10,Y-10);
DPYSST(NAME) ⊃ "DPYLN";
ISUBR DPYLS;
IF DEBUG2
THEN
⊂ "DPYLS"
ITEMVAR L;
DPYSET(DPYAA);
DPYBIG(TEXT);
DPYBRT(DIM);
∀ L|LINE⊗SCENE≡L DO
⊂ DPYL(L); DPYLN(L) ⊃;
DPYOUT(T1POG);
DPYINFO("LINES");
DPYBRK;
HYDPOG(T1POG) ⊃ "DPYLS";
α PRIMITIVES + PAGE 4;
ISUBR DPYB(ITEMVAR B);
IF DEBUG2
THEN
⊂ "DPYB" ITEMVAR L;
DPYSET(DPYAA); DPYBRT(BRIGHT);DPYBIG(TEXT);
NAME←PRINTNAME(B);
IF NAME="G"
THEN ∀ L| $ LINE⊗B≡L DO DPYL(L)
ELSE ∀ L| LINE⊗B≡L DO DPYL(L);
DPYOUT(APOG); DPYINFO("BODY "&NAME) ⊃ "DPYB";
ISUBR DPYBS;
IF DEBUG2
THEN
⊂ "DPYBS" ITEMVAR L,B;
SAFE REAL ARRAY ITEMVAR P;
∀ B|BODY⊗SCENE≡B DO
⊂ DPYTELL("BODY "&PRINTNAME(B));
DPYSET(DPYAA);
DPYBRT(BRIGHT);
DPYBIG(TEXT);
∀ L| LINE⊗B≡L DO DPYL(L);
DPYOUT(T1POG);
DPYLAB("LINES");
HYDPOG(T1POG);
DPYSET(DPYAA);
DPYBRT(BRIGHT);
DPYBIG(TEXT);
∀ P| POINT⊗B≡P DO
⊂ AIVECT(#X(P)-10,#Y(P)-10);
DPYSST(PRINTNAME(P)) ⊃;
DPYOUT(T1POG);
DPYLAB("POINTS") ⊃ ⊃ "DPYBS";
ISUBR DPYS;
IF DEBUG2
THEN
⊂ "DPYS" ITEMVAR L;
DB_LOC←TRUE;
DPYSET(DPYAA); DPYBRT(DIM); DPYBIG(TEXT);
∀ L|LINE⊗SCENE≡L DO DPYL(L);
DPYOUT(BPOG); DPYLAB("THE LOCAL SCENE") ⊃ "DPYS";
ISUBR DPYSCENE;
IF DEBUG2
THEN
⊂ "DPYSCENE" ITEMVAR L;
DPYSET(DPYAA); DPYBRT(DIM); DPYBIG(TEXT);
∀ L|$ LINE⊗SCENE≡L DO DPYL(L);
DPYOUT(BPOG); DPYLAB("THE GLOBAL SCENE") ⊃ "DPYSCENE";
ISUBR DPYDONE;
IF DEBUG2
THEN
⊂ "DPYDONE" ITEMVAR B,L;
DPYS;
DPYSET(DPYAA); DPYBRT(BRIGHT);DPYBIG(TEXT);
∀ B|BODY⊗SCENE≡B DO
∀ L|LINE⊗B≡L DO DPYL(L);
DPYTELL("RESULTS");
DPYOUT(APOG);
DPYLAB(CVS(LENGTH(BODY⊗SCENE))&" BODIES");
DB_INIT←FALSE ⊃ "DPYDONE";
α INITIALIZATION SUBRS;
ISUBR DPYINIT;
IF DEBUG2 ∧ ¬DB_INIT
THEN
⊂ "DPYINIT"
α PHYSICAL, LOGICAL CAMERA SIZE;
LDX ← 316; LDY ← 240;
α SOURCE WINDOW;
SXL←0; SXH←LDX; SDX←LDX;
SYL←0; SYH←LDY; SDY←LDY;
SXO←0; SYO←0; SA←SDX/SDY;
α DISPLAY WINDOW;
DDX←DDY←500; DA←1;
DXO←-500; DYO←0;
DXL←DXO; DXH←DXO+DDX; DYL←DYO; DYH←DYO+DDY;
α OBJECT WINDOW;
MAGX←MAGY←(IF SA>DA THEN DDX/SDX ELSE DDY/SDY);
OXL←DXO; OXH←DXO+MAGX*SDX;
OYL←DYO; OYH←DYO+MAGY*SDY;
DISX←DXO; DISY←DYO;
DXCTR←(DXL+DXH)/2; DYCTR←(DYL+DYH)/2;
DB_LOC←FALSE;
DPYTYP(-20,20,1);
DPYJOB("SEGMENTER");DPYLAB("DISPLAY INITIALIZED");
DB_INIT←TRUE;
⊃ "DPYINIT";
ISUBR DPYVINIT;
⊂ "DPYVINIT"
SAFE REAL ARRAY ITEMVAR P;
∀ P|POINT⊗SCENE≡P DO
⊂ ∂(P)[2]← SDY - ∂(P)[2];
∂(P)[6] ← MAGX * ∂(P)[1] + DISX;
∂(P)[7] ← MAGY * ∂(P)[2] + DISY; ⊃ ⊃ "DPYVINIT";
ISUBR DPYVI(SAFE REAL ARRAY ITEMVAR V);
IF DEBUG2
THEN
⊂ "DPYVI"
∂(V)[6] ← MAGX * ∂(V)[1] + DISX;
∂(V)[7] ← MAGY * ∂(V)[2] + DISY; ⊃ "DPYVI";
α FLIT
called from DPYBRK.
allows you to look at selected parts of
the associative store for debugging purposes.
TYPEIT="0" MEANS NO ITEMVAR !
TYPEIT="1" MEANS NO TYPE !
TYPEIT="4" MEANS REAL ITEMVAR
TYPEIT="6" MEANS SET ITEMVAR
TYPEIT="17" MEANS REAL ARRAY
;
ISUBR FLIT;
BEGIN "FLIT"
LABEL TRIPLE;
BOOLEAN GLBSW,DTMSW,ITMSW;
INTEGER FLAG,BREAK,I;
SAFE REAL ARRAY ITEMVAR XRA;
REAL ITEMVAR XR;
SET ITEMVAR XS;
ITEMVAR X,Y,Z; STRING STR,TOKEN,TRPSW;
SETBREAK(1,"≡⊗`, "&'12,'15,"ISN");
WHILE TRUE DO BEGIN "FLIT LOOP"
TYPE "COMMANDS: x,y,z x⊗y x⊗ANY x`y x`ANY GLOBAL DATUM NUMBER"&
↓&"*" EOM;
GLBSW←FALSE;
DTMSW←FALSE;
ITMSW←FALSE;
STR←INCHWL;
DO BEGIN "GET IT"
TOKEN←SCAN(STR,1,BREAK);
IF EQU(TOKEN,"DATUM")
THEN DTMSW←TRUE;
IF EQU(TOKEN,"NUMBER")
THEN ITMSW←TRUE;
IF EQU(TOKEN,"GLOBAL")
THEN GLBSW←TRUE;
END "GET IT" UNTIL ¬EQU(TOKEN,"DATUM") ∧ ¬EQU(TOKEN,"NUMBER")
∧ ¬EQU(TOKEN,"GLOBAL");
IF EQU(TOKEN,"Q")
THEN DONE;
IF ITMSW ∨ DTMSW
THEN DO BEGIN "CONVRT"
X←CVSI(TOKEN,FLAG);
IF FLAG ∨ TYPEIT(X)=0
THEN TYPE "NO ITEM - "&TOKEN EOM
ELSE IF ITMSW
THEN TYPE "PNAME:"&PRINTNAME(X)&TAB&"ITEM:"&CVOS(CVN(X)) EOM;
IF DTMSW
THEN CASE TYPEIT(X) OF
BEGIN "DATUMS"
[1] ⊂ "NONE" TYPE "*** NO TYPE ! ***" EOM; ⊃ "NONE";
[4] ⊂ "REAL"
XR←CVSI(TOKEN,FLAG);
TYPE "REAL ITEMVAR DATUM" EOM;
IF GLBSW
THEN TYPE "PNAME:"&PRINTNAME(XR)&CVG(GLB ∂(XR)) EOM
ELSE TYPE "PNAME:"&PRINTNAME(XR)&CVG(∂(XR)) EOM;
⊃ "REAL";
[6] ⊂ "SET"
XS←CVSI(TOKEN,FLAG);
TYPE "SET ITEMVAR DATUM" EOM;
IF GLBSW
THEN ∀ X|X ε $ ∂(XS) DO TYPE PRINTNAME(X)&" " EOS
ELSE ∀ X|X ε ∂(XS) DO TYPE PRINTNAME(X)&" " EOS;
TYPE "DONE" EOM;
⊃ "SET";
[17] ⊂ "REAL ARRAY"
XRA←CVSI(TOKEN,FLAG);
TYPE "REAL ARRAY ITEMVAR DATUM" EOM;
IF GLBSW
THEN FOR I←1 S1U 4 DO
TYPE CVG(GLB ∂(XRA)[I])&", " EOS
ELSE FOR I←1 S1U 7 DO
TYPE CVG(∂(XRA)[I])&", " EOS;
TYPE "DONE" EOM;
⊃ "REAL ARRAY"
END "DATUMS";
END "CONVRT" UNTIL STR=NULL;
X←CVSI(TOKEN,FLAG);
IF BREAK="⊗" ∨ BREAK="`"
THEN BEGIN "SET"
TRPSW←BREAK;
TOKEN←SCAN(STR,1,BREAK);
Y←CVSI(TOKEN,FLAG);
IF BREAK="≡"
THEN GO TRIPLE;
IF TRPSW="⊗"
THEN IF EQU(TOKEN,"ANY")
THEN IF GLBSW
THEN ∀ Z|GLB X⊗ANY≡Z DO TYPE PRINTNAME(Z)&" " EOS
ELSE ∀ Z|X⊗ANY≡Z DO TYPE PRINTNAME(Z)&" " EOS
ELSE IF GLBSW
THEN ∀ Z|GLOBAL X⊗Y≡Z DO TYPE PRINTNAME (Z)&" " EOS
ELSE ∀ Z|X⊗Y≡Z DO TYPE PRINTNAME (Z)&" " EOS
ELSE IF EQU(TOKEN,"ANY")
THEN IF GLBSW
THEN ∀ Z|GLB X⊗Z≡ANY DO TYPE PRINTNAME(Z)&" " EOS
ELSE ∀ Z|X⊗Z≡ANY DO TYPE PRINTNAME(Z)&" " EOS
ELSE IF GLBSW
THEN ∀ Z|GLOBAL X⊗Z≡ANY DO TYPE PRINTNAME(Z)&" " EOS
ELSE ∀ Z|X⊗Z≡Y DO TYPE PRINTNAME(Z)&" " EOS;
TYPE "THAT'S ALL OF 'EM." EOM;
END "SET"
ELSE BEGIN "TRIPLE"
TOKEN←SCAN(STR,1,BREAK);
Y←CVSI(TOKEN,FLAG);
TRIPLE: TOKEN←SCAN(STR,1,BREAK);
Z←CVSI(TOKEN,FLAG);
IF GLBSW
THEN IF GLOBAL X⊗Y≡Z
THEN TYPE "(GLOBAL) TRUE" EOM
ELSE TYPE "(GLOBAL) FALSE" EOM
ELSE IF X⊗Y≡Z
THEN TYPE "TRUE" EOM
ELSE TYPE "FALSE" EOM;
END "TRIPLE";
END "FLIT LOOP";
DPYBRK;
END "FLIT";
END "SEGDPY - SEGMENTER'S DISPLAY ROUTINES";